home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
TPUG - Toronto PET Users Group
/
TPUG Users Group CD
/
TPUG Users Group CD.iso
/
COMAL
/
B-Book Series
/
(k)b2.d64
/
enrol
< prev
next >
Wrap
Text File
|
2007-02-28
|
4KB
|
165 lines
0010 //OLDHAM'S GRAMMAR SCHOOL//
0020 //PROGRAM TO ADMINISTER PUPILS' MARKS//
0030 //WRITTEN BY CHRIS BORGE IN CBM COMAL-80//
0040 //THIS VERSION: JAN. 1981//
0050 //THIS PART: TO ENROL PUPILS//
0060 //
0070 MAX:=8
0080 DIM NAME$(MAX) OF 20, ANSW$ OF 10
0090 DIM THISNAME$ OF 20
0100 DIM MARK(MAX,3), SUBJ$(3) OF 11, KEY'(MAX)
0110 DIM SPACES$ OF 39
0120 //*
0130 SUBJ$(1):="ENGLISH"
0140 SUBJ$(2):="MATHEMATICS"
0150 SUBJ$(3):="FRENCH"
0160 SPACES$(1:39):=""
0190 //
0200 STARTSYSTEM
0210 //
0220 //* MAINLINES *//
0230 REPEAT
0240 PRINT CHR$(147) //CLEAR SCREEN
0250 FIELD(8,15)
0260 PRINT "1=ENROLL"
0270 PRINT "2=LIST"
0280 PRINT "3=STOP"
0290 PRINT
0300 INPUT "> ": JOBCODE
0310 IF JOBCODE=1 THEN ENROL
0320 IF JOBCODE=2 THEN PRINTOUT
0330 IF JOBCODE=3 THEN STOPSYSTEM
0340 UNTIL FALSE
0350 //
0360 PROC ENROL
0370 PRINT CHR$(147) //CLEAR//
0380 FIELD(8,20)
0390 INPUT "NEW CLASS (YES/RETURN): ": ANSW$
0400 IF ANSW$="YES" THEN
0410 NEWCLASS
0420 ELSE
0430 TAKEIN("PUPILNO")
0440 WHILE MORE DO
0450 IF NAME$(PUPILNO)<>"" THEN
0460 ERROR(3)
0470 ELSE
0480 TAKEIN("PUPILNAME")
0490 NAME$(PUPILNO):=THISNAME$
0500 FOR SUBJNO:=1 TO 3 DO MARK(PUPILNO,SUBJNO):=-1
0510 ENDIF
0520 TAKEIN("PUPILNO")
0530 ENDWHILE
0540 ENDIF
0550 ENDPROC ENROL
0560 //
0570 PROC NEWCLASS
0580 TAKEIN("CLASS")
0590 INITCLASS
0600 PRINT CHR$(147) //CLEAR SCREEN//
0610 PUPILNO:=1
0620 TAKEIN("PUPILNAME")
0630 WHILE NOT (THISNAME$="" OR PUPILNO=MAX) DO
0640 NAME$(PUPILNO):=THISNAME$
0650 PUPILNO:=PUPILNO+1
0660 TAKEIN("PUPILNAME")
0670 ENDWHILE
0680 PRINT CHR$(147)
0690 ENDPROC NEWCLASS
0700 //
0710 PROC INITCLASS
0720 FOR PUPILNO:=1 TO MAX DO
0730 NAME$(PUPILNO):=""
0740 FOR SUBJNO:=1 TO 3 DO MARK(PUPILNO,SUBJNO):=-1
0750 ENDFOR PUPILNO
0760 ENDPROC INITCLASS
0770 //
0780 PROC TAKEIN(MATTER$)
0790 REPEAT
0800 FIELD(8,10)
0810 CASE MATTER$ OF
0820 WHEN "PUPILNO"
0830 INPUT "PUPIL NUMBER (0 TO STOP): ": PUPILNO
0840 WHEN "PUPILNAME"
0850 PRINT "PUPIL NUMBER ",PUPILNO,
0860 INPUT " : ": THISNAME$
0870 WHEN "CLASS"
0880 INPUT "CLASS (8,9,10): ": CLASS
0890 ENDCASE
0900 CONTROL
0910 UNTIL OK
0920 PRINT CHR$(147) //CLEAR SCREEN
0930 ENDPROC TAKEIN
0940 //
0950 PROC CONTROL
0960 CASE MATTER$ OF
0970 WHEN "PUPILNO"
0980 OK:=(0<=PUPILNO AND PUPILNO<=MAX)
0990 MORE:=(PUPILNO>0)
1000 WHEN "PUPILNAME"
1010 OK:=TRUE //NO TEST//
1020 WHEN "CLASS"
1030 OK:=(CLASS=8)
1040 LACKING:=(CLASS=9 OR CLASS=10)
1050 ENDCASE
1060 IF NOT OK THEN ERROR(10)
1070 ENDPROC CONTROL
1080 //
1090 PROC ERROR(NO)
1100 FIELD(1,3)
1110 PRINT "ERROR!"
1120 //
1130 //NOT FINISHED//
1140 //
1150 ENDPROC ERROR
1160 //
1170 //
1180 PROC FIELD(L1,L2)
1190 SCREEN(L1,1)
1200 FOR I:=1 TO L2-L1+1 DO PRINT SPACES$
1210 SCREEN(L1,1)
1220 PRINT
1230 ENDPROC FIELD
1240 //
1250 PROC SCREEN(ROW,COL) CLOSED
1260 PRINT CHR$(19) //HOME
1270 FOR I:=1 TO ROW DO PRINT //DOWN
1275 FOR I:=1 TO COL-1 DO PRINT CHR$(29), //RIGHT
1280 ENDPROC SCREEN
1290 //
1300 PROC STARTSYSTEM
1310 OPEN FILE 2,"MARKBOOKS",READ
1320 FOR PUPILNO:=1 TO MAX DO
1330 READ FILE 2: NAME$(PUPILNO)
1340 FOR SUBJNO:=1 TO 3 DO READ FILE 2: MARK(PUPILNO,SUBJNO)
1350 ENDFOR PUPILNO
1360 CLOSE
1370 ENDPROC STARTSYSTEM
1380 //
1390 PROC STOPSYSTEM
1400 OPEN FILE 2,"@0:MARKBOOKS",WRITE
1410 FOR PUPILNO:=1 TO MAX DO
1420 WRITE FILE 2: NAME$(PUPILNO)
1430 FOR SUBJNO:=1 TO 3 DO WRITE FILE 2: MARK(PUPILNO,SUBJNO)
1440 ENDFOR PUPILNO
1450 CLOSE
1460 STOP
1470 ENDPROC STOPSYSTEM
1480 //
1490 PROC PRINTOUT
1500 PRINT CHR$(147) //CLEAR
1510 FOR PUPILNO:=1 TO MAX DO
1520 FIELD(8,9)
1530 IF NAME$(PUPILNO)<>"" THEN
1540 THISNAME$:=NAME$(PUPILNO)
1550 PRINT "STUDENT NUMBER ",PUPILNO,", ",THISNAME$
1560 PRINT "HAS ACHIEVED THE FOLLOWING RESULTS:"
1570 PRINT
1580 FOR SUBJNO:=1 TO 3 DO
1590 PRINT SUBJ$(SUBJNO),": ",TAB(25),MARK(PUPILNO,SUBJNO)
1600 ENDFOR SUBJNO
1610 PRINT
1620 INPUT "PRESS RETURN-KEY: ": ANSW$
1630 ENDIF
1640 ENDFOR PUPILNO
1650 ENDPROC PRINTOUT